{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE TypeSynonymInstances       #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# OPTIONS -Wall #-}

--------------------------------------------------------------------------------
-- |
-- Module      :  Majalan.Base.Internal.Base
-- Copyright   :  (c) Stephen Tetley 2014
-- License     :  BSD3
--
-- Maintainer  :  stephen.tetley@gmail.com
-- Stability   :  unstable
-- Portability :  GHC
--
-- Base
-- 
--------------------------------------------------------------------------------

module Majalan.Base.Internal.Base
  ( 

    Decimal
  , Seconds
  , Onset 
  , BPM
  , TimeSig
  , barLength
  , beatLength
  , bpmFromQnl

  , TimeSpan(..)
  , unionTimeSpan


  , Beat
  , beatToSeconds
  , secondsToBeat


  , PitchSet
  , pitchSet
  , getPitches

  , HzPitch
  , TPitch(..)

  , CsOrch(..)

  , replaceAns

  , intervalCents

  )  where


import Data.Fixed
import Data.Monoid
import Data.Ratio
import qualified Data.Set as Set

type Decimal = Fixed E9


type Seconds = Decimal
type Onset   = Seconds


type BPM     = Decimal


type TimeSig  = (Int,Int)
  



barLength :: TimeSig -> BPM -> Seconds
barLength (n,d) bpm = fromIntegral n * (dsclf * qnlen)
  where
    qnlen = 60 / bpm
    dsclf = 4 / fromIntegral d      -- denominator scaling factor


beatLength :: TimeSig -> BPM -> Seconds 
beatLength ts@(n,_) bpm = 
    let tot = barLength ts bpm in tot / fromIntegral n


bpmFromQnl :: Seconds -> BPM 
bpmFromQnl qnl = 60 / qnl

--------------------------------------------------------------------------------
-- Time spans

-- | Time span - note does not support monoid instance.
--
data TimeSpan = TimeSpan 
    { tspan_start       :: !Seconds
    , tspan_duration    :: !Seconds
    } 
  deriving (Eq,Show)


unionTimeSpan :: TimeSpan -> TimeSpan -> TimeSpan
unionTimeSpan (TimeSpan st1 d1) (TimeSpan st2 d2) = 
    let st  = min st1 st2
        end = max (st1 + d1) (st2 + d2)
    in TimeSpan st (end - st)


--------------------------------------------------------------------------------
-- Beat

-- | 1.0 = 1 qn
--
newtype Beat = Beat { getBeat :: Fixed E9 }
  deriving (Eq,Ord,Num,Fractional,Real,RealFrac)  

instance Show Beat where show = show . getBeat


beatToSeconds :: BPM -> Beat -> Seconds
beatToSeconds bpm a = let dwn_secs = (realToFrac $ 60 / bpm)
                      in realToFrac a * dwn_secs

secondsToBeat :: BPM -> Seconds -> Beat
secondsToBeat bpm d = let dwn_secs = (realToFrac $ 60 / bpm)
                      in realToFrac d / dwn_secs



--------------------------------------------------------------------------------
-- Pitch Set

newtype PitchSet pch = PitchSet { getPitchSet :: Set.Set pch }

instance Ord pch => Monoid (PitchSet pch)where
  mempty = PitchSet $ mempty
  a `mappend` b = PitchSet $ getPitchSet a `mappend` getPitchSet b


pitchSet :: Ord pch => [pch] -> PitchSet pch
pitchSet = PitchSet . Set.fromList

getPitches :: Ord pch => PitchSet pch -> [pch]
getPitches = Set.toAscList . getPitchSet


--------------------------------------------------------------------------------
--



newtype HzPitch = HzPitch { getHzPitch :: Decimal } 
  deriving (Eq,Ord,Num,Fractional,Real,RealFrac)

instance Show HzPitch where
  showsPrec p d = showsPrec p $ getHzPitch d


class TPitch pch where
   toHertz :: HzPitch -> pch -> Decimal

instance TPitch Decimal where
   toHertz _ pch = pch




--------------------------------------------------------------------------------


-- An Enum-like type class to assign instrument numbers
class CsOrch a where
  instNumber :: a -> Int


instance CsOrch Int where
  instNumber = id


replaceAns :: Functor m => a -> m z -> m a
replaceAns a = fmap (const a)

--------------------------------------------------------------------------------
-- 

intervalCents :: Rational -> Double
intervalCents r = logBase 10 (n/d) * (1200 / logBase 10 2)
  where
    n = fromIntegral $ numerator r
    d = fromIntegral $ denominator r
